home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Environments / PowerMacOberon feb96 / Source / EditKeys.Mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1995-08-02  |  22.2 KB  |  573 lines  |  [TEXT/.Ob4]
  1. Syntax10.Scn.Fnt
  2. Syntax10i.Scn.Fnt
  3. StampElems
  4. Alloc
  5. 2 Aug 95
  6. InfoElems
  7. Alloc
  8. Syntax10.Scn.Fnt
  9. Syntax10i.Scn.Fnt
  10. "Title": EditKeys
  11. "Author": CAS/MH/SHML/MK/HM
  12. "Abstract": Makros for Edit
  13. "Keywords": no keywords
  14. "Version": 
  15. "From":  02.08.95 08:49:48
  16. "Until": no date (use StampElems.Insert)
  17. "Changes":
  18. 95-06-01 MK    EditKeys installed through HandlerElems
  19. 95-08-02 HM    Bug corrected (super handler was not called)
  20. Syntax10b.Scn.Fnt
  21. MODULE EditKeys;    (* CAS/MH/SHML/MK/HM / 
  22.  << *)
  23.         (* changes: MK 1 Jun 95 install EditKeys through HandlerElems  *)
  24.     IMPORT
  25.         Files, Oberon, Input, Fonts, Display, Viewers, MenuViewers, Texts, TextFrames, HandlerElems;
  26.     CONST
  27.         IdentLen = 32; DefaultFile = "EditKeys.Text"; DefaultMacro = "OTHERWISE"; InstallMacro = "INSTALL";
  28.         (*scanner symbols*)
  29.             cmdSym = 0; nameSym = 1; stretchSym = 2; lparen = 3; rparen = 4; bslash = 5; eof = 6;
  30.         (*built-in commands*)
  31.             (*w/ param*)
  32.             writeCmd = "0"; charCmd = "1"; fntCmd = "2"; voffCmd = "3"; callCmd = "4";
  33.             argCmd = "A"; execCmd = "B"; paramCmd = "C";
  34.             (*w/o param*)
  35.             keepCmd = "5"; pickCmd = "6"; caretCmd = "7"; indentCmd = "8"; freezeCmd = "9";
  36.         (*preset.set*)
  37.             fntPreset = 0; pickPreset = 1; voffPreset = 2; caretPreset = 3; freezePreset = 4;
  38.         Menu = "System.Close  System.Copy  System.Grow  Edit.Search  Edit.Replace  Edit.Parcs  Edit.Store ";
  39.     TYPE
  40.         Ident = ARRAY IdentLen OF CHAR;
  41.         Definition = POINTER TO DefinitionDesc;
  42.         Sequence = POINTER TO SequenceDesc;
  43.         DefinitionDesc = RECORD
  44.             left, right: Definition;
  45.             in: BOOLEAN;
  46.             trig: Ident;
  47.             seq: Sequence
  48.         END;
  49.         SequenceDesc = RECORD
  50.             next: Sequence;
  51.             sym: INTEGER;
  52.             cmd: CHAR;
  53.             def: Definition;
  54.             stretch: Texts.Buffer
  55.         END;
  56.         defs, dmy: Definition;
  57.         ch, cmd, hotKey: CHAR;
  58.         sym, errs: INTEGER;
  59.         errpos: LONGINT;
  60.         name, trig: Ident;
  61.         stretch, buf, indent: Texts.Buffer;
  62.         T: Texts.Text;
  63.         R: Texts.Reader;
  64.         W, WB, WL: Texts.Writer;    (*out, compose, host editor*)
  65.         map: ARRAY 17 OF CHAR;
  66.         preset: RECORD
  67.             set: SET;
  68.             pos, caret: LONGINT;
  69.             frame: TextFrames.Frame;
  70.             def, fnt: Fonts.Font;
  71.             voff: SHORTINT
  72.         END;
  73.         SuperHandler: Display.Handler;
  74.     PROCEDURE Flip (VAR src, dst: ARRAY OF CHAR);
  75.         VAR i, j: INTEGER;
  76.     BEGIN i := -1; j := 0;
  77.         REPEAT INC(i) UNTIL src[i] = 0X;
  78.         WHILE i > 0 DO DEC(i); dst[j] := src[i]; INC(j) END;
  79.         dst[j] := 0X
  80.     END Flip;
  81.     PROCEDURE WLog;
  82.     BEGIN Texts.Append(Oberon.Log, W.buf)
  83.     END WLog;
  84.     PROCEDURE Ch (ch: CHAR);
  85.     BEGIN Texts.Write(W, ch)
  86.     END Ch;
  87.     PROCEDURE Str (s: ARRAY OF CHAR);
  88.     BEGIN Texts.WriteString(W, s)
  89.     END Str;
  90.     PROCEDURE FlipStr (s: ARRAY OF CHAR);
  91.         VAR n: Ident;
  92.     BEGIN Flip(s, n); Str(n)
  93.     END FlipStr;
  94.     PROCEDURE Gap;
  95.     BEGIN Str("  ")
  96.     END Gap;
  97.     PROCEDURE Ln;
  98.     BEGIN Texts.WriteLn(W)
  99.     END Ln;
  100.     PROCEDURE Char (ch: CHAR);
  101.         VAR pat: Display.Pattern; i, n, dx, x, y, w, h: INTEGER;
  102.             d: ARRAY 3 OF CHAR;
  103.     BEGIN Display.GetChar(W.fnt.raster, ch, dx, x, y, w, h, pat);
  104.         IF h > 0 THEN Ch(ch); Str(" (* ") END;
  105.         Ch("#"); i := 0; n := ORD(ch);
  106.         REPEAT d[i] := map[n MOD 10]; n := n DIV 10; INC(i) UNTIL n = 0;
  107.         WHILE i > 0 DO DEC(i); Ch(d[i]) END;
  108.         IF h = 0 THEN Str(" (* ") ELSE Str(", ") END;
  109.         Ch("0"); i := 0; n := ORD(ch);
  110.         REPEAT d[i] := map[n MOD 16]; n := n DIV 16; INC(i) UNTIL n = 0;
  111.         WHILE i > 0 DO DEC(i); Ch(d[i]) END;
  112.         Str("X *)")
  113.     END Char;
  114.     PROCEDURE Append (SB, DB: Texts.Buffer);
  115.     BEGIN Texts.Copy(SB, DB); Texts.OpenBuf(SB)
  116.     END Append;
  117.     (* table handler *)
  118.     PROCEDURE Find (VAR name, trig: Ident; insert: BOOLEAN): Definition;
  119.         VAR p, q, d, x: Definition; i: INTEGER;
  120.     BEGIN Flip(name, trig); p := defs; d := p.right; q := NIL; x := NIL;
  121.         WHILE d # NIL DO i := 0;
  122.             WHILE (trig[i] # 0X) & (trig[i] = d.trig[i]) DO INC(i) END;
  123.             IF trig[i] = d.trig[i] THEN x := d; d := NIL
  124.             ELSIF trig[i] = 0X THEN q := d; d := NIL
  125.             ELSIF trig[i] < d.trig[i] THEN p := d; d := d.left
  126.             ELSE p := d; d := d.right
  127.             END
  128.         END;
  129.         IF insert & (x # NIL) THEN Str(name); Str(" already defined"); Ln; WLog END;    (*<<*)
  130.         IF insert & (x = NIL) THEN NEW(x); x.right := q; x.in := FALSE; x.trig := trig;
  131.             IF trig < p.trig THEN p.left := x ELSE p.right := x END;
  132.             IF q # NIL THEN dmy.right := NIL; p := dmy;
  133.                 WHILE q.left # NIL DO
  134.                     WHILE (q.left # NIL) & (q.left.trig > trig) DO q := q.left END;
  135.                     WHILE (q.left # NIL) & (q.left.trig < trig) DO p.right := q.left; p := p.right; q.left := p.right; p.right := NIL END
  136.                 END;
  137.                 x.left := dmy.right
  138.             END
  139.         END;
  140.         RETURN x
  141.     END Find;
  142.     PROCEDURE ResetDefs;
  143.         VAR def: Definition; seq: Sequence;
  144.     BEGIN defs.right := NIL; defs.trig[0] := 0X; hotKey := "\";
  145.         name := DefaultMacro; def := Find(name, trig, TRUE);
  146.         NEW(def.seq); seq := def.seq;
  147.         seq.sym := cmdSym; seq.cmd := pickCmd;
  148.         NEW(seq.next); seq := seq.next;
  149.         Texts.OpenBuf(WB.buf); Texts.Write(WB, "\");
  150.         seq.sym := stretchSym; seq.stretch := WB.buf;
  151.         NEW(WB.buf); Texts.OpenBuf(WB.buf);
  152.         NEW(seq.next); seq := seq.next;
  153.         seq.sym := cmdSym; seq.cmd := writeCmd
  154.     END ResetDefs;
  155.     PROCEDURE Trigger (VAR trig: Ident): Definition;
  156.         VAR d, x: Definition; i: INTEGER;
  157.     BEGIN d := defs.right; x := NIL;
  158.         WHILE d # NIL DO i := 0;
  159.             WHILE (trig[i] # 0X) & (trig[i] = d.trig[i]) DO INC(i) END;
  160.             IF trig[i] = d.trig[i] THEN RETURN d END;
  161.             IF d.trig[i] = 0X THEN x := d END;
  162.             IF trig[i] < d.trig[i] THEN d := d.left ELSE d := d.right END
  163.         END;
  164.         RETURN x
  165.     END Trigger;
  166.     (* macro compiler *)
  167.     PROCEDURE Mark (err: ARRAY OF CHAR);
  168.     BEGIN INC(errs);
  169.         IF Texts.Pos(R) - errpos > 9 THEN
  170.             errpos := Texts.Pos(R); Ln; Str("  pos  "); Texts.WriteInt(W, errpos, 0); Gap; Str(err); WLog
  171.         END
  172.     END Mark;
  173.     PROCEDURE GetCh;
  174.     BEGIN Texts.Read(R, ch)
  175.     END GetCh;
  176.     PROCEDURE CharCode;
  177.         VAR c: INTEGER;
  178.     BEGIN c := 0;
  179.         WHILE ("0" <= ch) & (ch <= "9") DO c := c * 10 + SHORT(ORD(ch) - 30H); GetCh END;
  180.         name[0] := CHR(c); name[1] := 0X    (*unchecked*)
  181.     END CharCode;
  182.     PROCEDURE Name;
  183.         VAR i: INTEGER;
  184.     BEGIN i := 0;
  185.         REPEAT name[i] := ch; INC(i); GetCh
  186.         UNTIL (ch <= " ") OR (ch = "(") OR (ch = ")") OR R.eot OR (i = IdentLen-1);
  187.         IF ~((ch <= " ") OR (ch = "(") OR (ch = ")") OR R.eot) THEN Mark("name too long") END;
  188.         name[i] := 0X
  189.     END Name;
  190.     PROCEDURE Save (text: Texts.Text; beg, end: LONGINT; buf: Texts.Buffer);
  191.     BEGIN
  192.         IF end > beg THEN Texts.Save(text, beg, end, buf) END
  193.     END Save;
  194.     PROCEDURE Stretch;
  195.         VAR beg, end: LONGINT;
  196.     BEGIN beg := Texts.Pos(R); end := beg; GetCh;
  197.         WHILE ~R.eot & (ch # 22X) DO INC(end); GetCh END;
  198.         IF ch = 22X THEN GetCh;
  199.             IF end > beg THEN NEW(stretch); Texts.OpenBuf(stretch); Save(T, beg, end, stretch)
  200.             ELSE Mark("empty stretch")
  201.             END
  202.         ELSE Mark("Closing quote expected")
  203.         END
  204.     END Stretch;
  205.     PROCEDURE Comment;
  206.     BEGIN
  207.         LOOP
  208.             IF ch = "(" THEN GetCh;
  209.                 IF ch = "*" THEN GetCh; Comment END
  210.             ELSIF ch = "*" THEN GetCh;
  211.                 IF ch = ")" THEN GetCh; EXIT END
  212.             ELSE GetCh
  213.             END
  214.         END
  215.     END Comment;
  216.     PROCEDURE GetSym;
  217.     BEGIN sym := eof;
  218.         REPEAT
  219.             IF (0X <= ch) & (ch <= " ") THEN GetCh
  220.             ELSIF ch = 22X THEN sym := stretchSym; Stretch
  221.             ELSIF ch = "#" THEN sym := nameSym; GetCh; CharCode
  222.             ELSIF ch = "(" THEN GetCh; IF ch = "*" THEN GetCh; Comment ELSE sym := lparen END
  223.             ELSIF ch = ")" THEN sym := rparen; GetCh
  224.             ELSIF ch = "\" THEN sym := bslash; GetCh
  225.             ELSIF ch = "^" THEN sym := cmdSym; GetCh; cmd := ch; GetCh
  226.             ELSE sym := nameSym; Name
  227.             END
  228.         UNTIL (sym # eof) OR R.eot
  229.     END GetSym;
  230.     PROCEDURE ParseText;
  231.         VAR def: Definition; beg, seq: Sequence;
  232.     BEGIN GetSym;
  233.         IF sym = bslash THEN
  234.             GetSym; IF sym = nameSym THEN hotKey := name[0]; GetSym ELSE Mark("hot-key code expected") END
  235.         END;
  236.         WHILE sym = nameSym DO GetSym; def := Find(name, trig, TRUE);
  237.             IF sym = lparen THEN
  238.                 GetSym; NEW(beg); seq := beg; beg.next := NIL;
  239.                 WHILE sym IN {cmdSym, nameSym, stretchSym} DO
  240.                     NEW(seq.next); seq := seq.next; seq.sym := sym;
  241.                     IF sym = cmdSym THEN seq.cmd := cmd
  242.                     ELSIF sym = nameSym THEN seq.def := Find(name, trig, FALSE);
  243.                         IF seq.def = NIL THEN Mark("illegal forward reference") END
  244.                     ELSE (*sym = stretchSym*) seq.stretch := stretch
  245.                     END;
  246.                     GetSym
  247.                 END;
  248.                 def.seq := beg.next; IF sym = rparen THEN GetSym ELSE Mark(") expected") END
  249.             ELSE Mark("( expected")
  250.             END
  251.         END;
  252.         IF sym # eof THEN GetSym;
  253.             IF sym # eof THEN Mark("unexpected trailing char.s") END
  254.         END;
  255.         stretch := NIL
  256.     END ParseText;
  257.     PROCEDURE ReadText (name: ARRAY OF CHAR; beg: LONGINT);
  258.     BEGIN Texts.OpenReader(R, T, beg); GetCh;
  259.         IF ~R.eot THEN Str("  reading "); Str(name); WLog; errs := 0; errpos := -10; ParseText;
  260.             IF errs = 0 THEN Str(" done") ELSE ResetDefs END;
  261.             Ln; WLog
  262.         END
  263.     END ReadText;
  264.     (* macro processor *)
  265.     PROCEDURE Insert (frame: TextFrames.Frame; buf: Texts.Buffer);
  266.         VAR pos, len: LONGINT;
  267.     BEGIN pos := frame.carloc.pos; len := buf.len;
  268.         Texts.Insert(frame.text, pos, buf); TextFrames.SetCaret(frame, pos + len)
  269.     END Insert;
  270.     PROCEDURE Delete (frame: TextFrames.Frame; beg, end: LONGINT);
  271.     BEGIN Texts.Delete(frame.text, beg, end); TextFrames.SetCaret(frame, beg)
  272.     END Delete;
  273.     PROCEDURE Err (def: Definition; s: ARRAY OF CHAR);
  274.     BEGIN INC(errs); Gap; Str(s); Str(" in "); FlipStr(def.trig); Ln; WLog
  275.     END Err;
  276.     PROCEDURE PopArg (def: Definition; class: SHORTINT; VAR S: Texts.Scanner; VAR stack: Sequence);
  277.         VAR B: Texts.Buffer;
  278.     BEGIN
  279.         IF stack # NIL THEN T := TextFrames.Text("");
  280.             NEW(B); Texts.OpenBuf(B); Texts.Copy(stack.stretch, B);
  281.             Texts.Append(T, B); Texts.OpenScanner(S, T, 0); Texts.Scan(S); stack := stack.next;
  282.             IF (class >= 0) & (S.class # class) THEN Err(def, "illegal param type") END
  283.         ELSE Err(def, "missing param")
  284.         END
  285.     END PopArg;
  286.     PROCEDURE PushArg (buf: Texts.Buffer; VAR stack: Sequence);
  287.         VAR u: Sequence;
  288.     BEGIN NEW(u); u.next := stack; stack := u; u.stretch := buf
  289.     END PushArg;
  290.     PROCEDURE ThisArg (n: LONGINT; args: Sequence): Sequence;
  291.     BEGIN
  292.         WHILE (n > 0) & (args # NIL) DO DEC(n); args := args.next END;
  293.         RETURN args
  294.     END ThisArg;
  295.     PROCEDURE GetArguments (text: Texts.Text; pos: LONGINT; VAR pin: LONGINT; VAR args: Sequence);
  296.         VAR B: Texts.Buffer; R: Texts.Reader; ch: CHAR;
  297.     BEGIN pin := pos; DEC(pos); Texts.OpenReader(R, text, pos); Texts.Read(R, ch);
  298.         IF ch = ":" THEN pin := pos;
  299.             WHILE pos > 0 DO DEC(pos); Texts.OpenReader(R, text, pos); Texts.Read(R, ch); (*inv text[pos] = ch*)
  300.                 IF ch <= " " THEN
  301.                     NEW(B); Texts.OpenBuf(B); Save(text, pos + 1, pin, B); PushArg(B, args);
  302.                     pin := pos + 1; RETURN
  303.                 ELSIF ch = ":" THEN
  304.                     NEW(B); Texts.OpenBuf(B); Save(text, pos + 1, pin, B); PushArg(B, args);
  305.                     pin := pos
  306.                 ELSIF (ch = 22X) & (pos = pin - 1) THEN ch := 0X;
  307.                     WHILE (pos > 0) & (ch # 22X) DO DEC(pos); Texts.OpenReader(R, text, pos); Texts.Read(R, ch) END;
  308.                     IF ch = 22X THEN
  309.                         NEW(B); Texts.OpenBuf(B); Save(text, pos + 1, pin - 1, B); PushArg(B, args);
  310.                         pin := pos;
  311.                         DEC(pos); Texts.OpenReader(R, text, pos); Texts.Read(R, ch);
  312.                         IF ch = ":" THEN pin := pos END;
  313.                         IF ch <= " " THEN RETURN END
  314.                     ELSE RETURN
  315.                     END
  316.                 END
  317.             END;
  318.             NEW(B); Texts.OpenBuf(B); Save(text, pos, pin, B); PushArg(B, args);
  319.             pin := pos
  320.         END
  321.     END GetArguments;
  322.     PROCEDURE Expand (def: Definition; VAR stack, args, params: Sequence);
  323.         VAR d: Definition; seq, u: Sequence; B: Texts.Buffer; S: Texts.Scanner; par: Oberon.ParList; res: INTEGER;
  324.     BEGIN
  325.         IF ~def.in THEN def.in := TRUE; seq := def.seq;
  326.             WHILE (errs = 0) & (seq # NIL) DO
  327.                 IF seq.sym = cmdSym THEN
  328.                     IF seq.cmd = writeCmd THEN
  329.                         IF stack # NIL THEN Append(stack.stretch, buf); stack := stack.next
  330.                         ELSE Err(def, "missing param")
  331.                         END
  332.                     ELSIF seq.cmd = charCmd THEN PopArg(def, Texts.Int, S, stack);
  333.                         Texts.Write(WB, CHR(S.i)); Append(WB.buf, buf)
  334.                     ELSIF seq.cmd = fntCmd THEN PopArg(def, Texts.Name, S, stack);
  335.                         INCL(preset.set, fntPreset); preset.fnt := Fonts.This(S.s)
  336.                     ELSIF seq.cmd = voffCmd THEN PopArg(def, Texts.Int, S, stack);
  337.                         INCL(preset.set, voffPreset); preset.voff := SHORT(SHORT(S.i))
  338.                     ELSIF seq.cmd = callCmd THEN PopArg(def, Texts.Name, S, stack);
  339.                         IF errs = 0 THEN NEW(par); par.vwr := Oberon.FocusViewer; par.frame := par.vwr.dsc.next;
  340.                             IF params # NIL THEN
  341.                                 par.text := TextFrames.Text("");
  342.                                 WHILE params # NIL DO Texts.Insert(par.text, 0, params.stretch);
  343.                                     params := params.next
  344.                                 END;
  345.                                 NEW(B); Texts.OpenBuf(B);
  346.                                 Texts.Save(T, Texts.Pos(S) - 1, T.len, B); Texts.Append(par.text, B);
  347.                                 par.pos := 0
  348.                             ELSE par.text := T; par.pos := Texts.Pos(S)
  349.                             END;
  350.                             Oberon.Call(S.s, par, FALSE, res);
  351.                             IF res # 0 THEN Texts.WriteInt(W, res, 3); Err(def, "call error ") END
  352.                         END
  353.                     ELSIF seq.cmd = argCmd THEN PopArg(def, Texts.Int, S, stack);
  354.                         IF errs = 0 THEN u := ThisArg(S.i, args);
  355.                             IF u # NIL THEN NEW(B); Texts.OpenBuf(B); Texts.Copy(u.stretch, B); PushArg(B, stack)
  356.                             ELSE Err(def, "missing argument")
  357.                             END
  358.                         END
  359.                     ELSIF seq.cmd = execCmd THEN PopArg(def, Texts.Name, S, stack);
  360.                         IF errs = 0 THEN COPY(S.s, name); d := Find(name, trig, FALSE);
  361.                             IF d # NIL THEN Expand(d, stack, args, params)
  362.                             ELSE Err(def, "exec of undefined macro")
  363.                             END
  364.                         END
  365.                     ELSIF seq.cmd = paramCmd THEN
  366.                         IF stack # NIL THEN u := stack; stack := stack.next; u.next := params; params := u
  367.                         ELSE Err(def, "missing param")
  368.                         END
  369.                     ELSIF seq.cmd = keepCmd THEN INCL(preset.set, fntPreset); preset.fnt := preset.def
  370.                     ELSIF seq.cmd = pickCmd THEN INCL(preset.set, pickPreset)
  371.                     ELSIF seq.cmd = caretCmd THEN INCL(preset.set, caretPreset); preset.caret := buf.len
  372.                     ELSIF seq.cmd = indentCmd THEN
  373.                         IF indent.len > 0 THEN Texts.Copy(indent, buf) END
  374.                     ELSIF seq.cmd = freezeCmd THEN INCL(preset.set, freezePreset)
  375.                     ELSE Err(def, "illegal built-in")
  376.                     END
  377.                 ELSIF seq.sym = nameSym THEN Expand(seq.def, stack, args, params)
  378.                 ELSE (*seq.sym = stretchSym*)
  379.                     NEW(B); Texts.OpenBuf(B); Texts.Copy(seq.stretch, B); PushArg(B, stack)
  380.                 END;
  381.                 seq := seq.next
  382.             END;
  383.             def.in := FALSE
  384.         ELSE Err(def, "cyclic expansion")
  385.         END
  386.     END Expand;
  387.     PROCEDURE InitialExec (name: Ident);
  388.         VAR def: Definition; stack, args, params: Sequence; trig: Ident;
  389.     BEGIN def := Find(name, trig, FALSE);
  390.         IF def # NIL THEN preset.set := {}; stack := NIL; args := NIL; params := NIL; errs := 0;
  391.             Expand(def, stack, args, params);
  392.             IF stack # NIL THEN Err(def, "superfluous param") END
  393.         END
  394.     END InitialExec;
  395.     PROCEDURE Process (frame: TextFrames.Frame; VAR del: LONGINT);
  396.         VAR def: Definition; org, pos, i, tlen, pin: LONGINT; stack, args, params: Sequence; default: BOOLEAN;
  397. dmy: Texts.Reader;
  398.     BEGIN errs := 0; del := 0; Texts.OpenBuf(buf); org := frame.carloc.pos;
  399.         pos := org - (IdentLen-1);
  400.         IF pos >= 0 THEN i := IdentLen-1 ELSE pos := 0; i := org END;
  401.         trig[i] := 0X; Texts.OpenReader(R, frame.text, pos);
  402.         WHILE i > 0 DO DEC(i); Texts.Read(R, trig[i]) END;
  403.         def := Trigger(trig);
  404.         IF def # NIL THEN default := FALSE; tlen := 0;
  405.             WHILE def.trig[tlen] # 0X DO INC(tlen) END
  406.         ELSE default := TRUE; name := DefaultMacro; def := Find(name, trig, FALSE); tlen := 0
  407.         END;
  408.         IF def # NIL THEN preset.set := {}; stack := NIL; args := NIL; params := NIL;
  409.             GetArguments(frame.text, org - tlen, pin, args);
  410. Texts.OpenReader(dmy, frame.text, 0);
  411.             Expand(def, stack, args, params);
  412.             IF stack # NIL THEN Err(def, "superfluous param") END;
  413.             IF errs = 0 THEN
  414.                 IF ~default THEN del := org - pin END;
  415.                 preset.frame := frame; preset.pos := frame.carloc.pos - del;
  416.                 IF caretPreset IN preset.set THEN INC(preset.pos, preset.caret) ELSE INC(preset.pos, buf.len) END
  417.             END
  418.         END
  419.     END Process;
  420.     (* editor interface *)
  421.     PROCEDURE Key (frame: TextFrames.Frame; ch: CHAR; VAR handled: BOOLEAN);
  422.         CONST TAB = 9X; LF = 0AX; CR = 0DX;
  423.         VAR del, pos, beg: LONGINT; voff: SHORTINT; fnt: Fonts.Font; ch1: CHAR;
  424.     BEGIN handled := TRUE; pos := frame.carloc.pos;
  425.         IF frame.text.len > 0 THEN
  426.             IF pos < frame.text.len THEN Texts.OpenReader(R, frame.text, pos); Texts.Read(R, ch1) END;
  427.             IF (pos > 0) & ((pos = frame.text.len) OR (ch1 <= " ")) THEN
  428.                 Texts.OpenReader(R, frame.text, pos - 1); Texts.Read(R, ch1)
  429.             END;
  430.             preset.def := R.fnt; Texts.SetColor(WL, R.col);
  431.             IF (ch = CR) OR (ch = TAB) OR (ch = LF) THEN Texts.SetOffset(WL, Oberon.CurOff)
  432.             ELSE Texts.SetOffset(WL, R.voff)
  433.             END
  434.         ELSE preset.def :=  Oberon.CurFnt; Texts.SetColor(WL, Oberon.CurCol); Texts.SetOffset(WL, Oberon.CurOff)
  435.         END;
  436.         fnt := preset.def; voff := WL.voff;
  437.         IF (preset.frame = frame) & (preset.pos = pos) THEN
  438.             IF fntPreset IN preset.set THEN fnt := preset.fnt END;
  439.             IF voffPreset IN preset.set THEN voff := preset.voff END
  440.         END;
  441.         preset.set := {}; preset.frame := NIL;
  442.         IF WL.fnt # fnt THEN Texts.SetFont(WL, fnt) END;
  443.         IF WL.voff # voff THEN Texts.SetOffset(WL, voff) END;
  444.         IF ch = hotKey THEN beg := frame.carloc.org; Texts.OpenReader(R, frame.text, beg); Texts.Read(R, ch1);
  445.             WHILE (Texts.Pos(R) <= pos) & (ch1 <= " ") DO Texts.Read(R, ch1) END;
  446.             Texts.OpenBuf(indent); Save(frame.text, beg, Texts.Pos(R) - 1, indent);
  447.             Process(frame, del);
  448.             IF ~(freezePreset IN preset.set) & (errs = 0) THEN
  449.                 IF frame.hasCar & (frame.carloc.pos # pos) THEN preset.pos := frame.carloc.pos - del END;
  450.                 TextFrames.SetCaret(frame, pos);
  451.                 IF del > 0 THEN Delete(frame, pos - del, pos) END;
  452.                 IF pickPreset IN preset.set THEN T := TextFrames.Text("");
  453.                     Texts.Append(T, buf); Texts.ChangeLooks(T, 0, T.len, {0}, preset.def, 0, 0);
  454.                     Save(T, 0, T.len, buf)
  455.                 END;
  456.                 Insert(frame, buf)
  457.             ELSE TextFrames.RemoveCaret(frame); preset.pos := frame.carloc.pos
  458.             END;
  459.             IF (0 <= preset.pos) & (preset.pos <= frame.text.len) THEN
  460.                 TextFrames.SetCaret(frame, preset.pos)
  461.             END
  462.         (*ELSIF (ch >= " ") & (ch # DEL) & (ch < 95X) OR (ch = 9BX) OR (ch = 9FX) THEN Texts.Write(WL, ch)*)
  463.         ELSE handled := FALSE
  464.         END;
  465.         IF (WL.buf.len > 0) & frame.hasCar THEN Insert(frame, WL.buf) END
  466.     END Key;
  467.     PROCEDURE Handle* (f: Display.Frame; VAR msg: Display.FrameMsg);
  468.         CONST InvalMsg = -1;
  469.         VAR frame: TextFrames.Frame; handled: BOOLEAN;
  470.     BEGIN
  471.         IF msg IS Oberon.InputMsg THEN
  472.             WITH msg: Oberon.InputMsg DO
  473.                 frame := f(TextFrames.Frame);
  474.                 IF (msg.id = Oberon.consume) & frame.hasCar THEN
  475.                     Key(frame, msg.ch, handled);
  476.                     IF handled THEN msg.id := InvalMsg END
  477.                 ELSIF (msg.id = Oberon.track) & (msg.keys # {}) THEN preset.set := {}
  478.                 END
  479.             END
  480.         END;
  481.         SuperHandler(f, msg)
  482.     END Handle;
  483.     (* commands *)
  484.     PROCEDURE Reset*;
  485.     BEGIN ResetDefs
  486.     END Reset;
  487.     PROCEDURE Read*;
  488.         VAR S: Texts.Scanner; text: Texts.Text; beg, end, time: LONGINT;
  489.     BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
  490.         IF (S.class = Texts.Char) & (S.c = "@") & (S.line = 0) THEN
  491.             Oberon.GetSelection(text, beg, end, time);
  492.             IF time > 0 THEN T := text; ReadText(" @ ", beg) END
  493.         ELSIF (S.class = Texts.Char) & (S.c = ":") & (S.nextCh = "=") & (S.line = 0) THEN Texts.Scan(S);
  494.             T := Oberon.Par.text; ReadText(" := ", Texts.Pos(S) - 1)
  495.         ELSE
  496.             IF (S.class = Texts.Char) & (S.c = "^") & (S.line = 0) THEN
  497.                 Oberon.GetSelection(text, beg, end, time);
  498.                 IF time > 0 THEN Texts.OpenScanner(S, text, beg); Texts.Scan(S) END
  499.             END;
  500.             WHILE S.class = Texts.Name DO T := TextFrames.Text(S.s); ReadText(S.s, 0); Texts.Scan(S) END
  501.         END;
  502.         T := NIL
  503.     END Read;
  504.     PROCEDURE Definitions*;
  505.         VAR S: Texts.Scanner; V: MenuViewers.Viewer; T, text: Texts.Text; tree: Definition;
  506.             beg, end, time: LONGINT; x, y: INTEGER;
  507.         PROCEDURE Sort(VAR d: Definition; VAR pat: ARRAY OF CHAR; VAR tree: Definition);
  508.             VAR i: INTEGER; t: Definition; n: Ident;
  509.             PROCEDURE Ins(VAR tree: Definition; t: Definition; VAR n: Ident);
  510.                 VAR m: Ident;
  511.             BEGIN
  512.                 IF tree = NIL THEN tree := t
  513.                 ELSE Flip(tree.trig, m);
  514.                     IF n < m THEN Ins(tree.left, t, n) ELSE Ins(tree.right, t, n) END
  515.                 END
  516.             END Ins;
  517.         BEGIN
  518.             IF d # NIL THEN Flip(d.trig, n); i := 0;
  519.                 WHILE (pat[i] # 0X) & (n[i] = pat[i]) DO INC(i) END;
  520.                 IF pat[i] = 0X THEN NEW(t); t^ := d^; t.left := NIL; t.right := NIL; Ins(tree, t, n) END;
  521.                 Sort(d.left, pat, tree); Sort(d.right, pat, tree)
  522.             END
  523.         END Sort;
  524.         PROCEDURE Write(tree: Definition);
  525.             PROCEDURE Seq(seq: Sequence);
  526.                 VAR b: Texts.Buffer;
  527.             BEGIN
  528.                 WHILE seq # NIL DO
  529.                     IF seq.sym = cmdSym THEN Ch("^"); Ch(seq.cmd)
  530.                     ELSIF seq.sym = nameSym THEN
  531.                         IF (name[1] = 0X) & ((name[0] < " ") OR (name[0] > 7EX)) THEN Char(name[0])
  532.                         ELSE FlipStr(seq.def.trig)
  533.                         END
  534.                     ELSE (*seq.sym = stretchSym*) Ch(22X); Append(W.buf, buf);
  535.                         NEW(b); Texts.OpenBuf(b); Texts.Copy(seq.stretch, b); Append(b, buf); Ch(22X)
  536.                     END;
  537.                     seq := seq.next; IF seq # NIL THEN Ch(" ") END
  538.                 END
  539.             END Seq;
  540.         BEGIN
  541.             IF tree # NIL THEN
  542.                 Write(tree.left); Gap; FlipStr(tree.trig); Gap; Ch("("); Seq(tree.seq); Ch(")"); Ln; Write(tree.right)
  543.             END
  544.         END Write;
  545.     BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
  546.         IF (S.line # 0) OR (S.class # Texts.String) & (S.class # Texts.Name) THEN
  547.             Oberon.GetSelection(text, beg, end, time);
  548.             IF time > 0 THEN Texts.OpenScanner(S, text, beg); Texts.Scan(S) END
  549.         END;
  550.         IF (S.line # 0) OR (S.class # Texts.String) & (S.class # Texts.Name) THEN S.s[0] := 0X END;
  551.         Str("(hotkey is "); Char(hotKey); Ch(")"); Ln;
  552.         tree := NIL; Sort(defs.right, S.s, tree); Texts.OpenBuf(buf); Write(tree); Append(W.buf, buf);
  553.         Oberon.AllocateSystemViewer(Oberon.Mouse.X, x, y); T := TextFrames.Text("");
  554.         Texts.Append(T, buf);
  555.         V := MenuViewers.New(TextFrames.NewMenu("EditKeys.Definitions", Menu),
  556.             TextFrames.NewText(T, 0), TextFrames.menuH, x, y)
  557.     END Definitions;
  558.     PROCEDURE GetKeyCode*;    (*<<*)
  559.     BEGIN Str("EditKeys.GetKeyCode  ('q' to quit)"); WLog;
  560.         REPEAT Input.Read(ch); Ln; Gap; Char(ch); WLog UNTIL ch = "q";
  561.         Ln; WLog
  562.     END GetKeyCode;
  563.     PROCEDURE Install*;   (* MK 1 Jun 95 *)
  564.     BEGIN
  565.         HandlerElems.SetHandler ("EditKeys.Handle", Handle, SuperHandler);
  566.     END Install;
  567. BEGIN Texts.OpenWriter(W); Texts.OpenWriter(WB); Texts.OpenWriter(WL);
  568.     NEW(defs); NEW(dmy); NEW(buf); NEW(indent); map := "0123456789ABCDEF";
  569.     ResetDefs;
  570.     T := TextFrames.Text(DefaultFile); ReadText(DefaultFile, 0); T := NIL;
  571.     InitialExec(InstallMacro)
  572. END EditKeys.
  573.